home *** CD-ROM | disk | FTP | other *** search
/ PC Media 2 / PC MEDIA CD02.iso / share / prog / crc16pas / crc16.pas
Encoding:
Pascal/Delphi Source File  |  1991-10-10  |  3.7 KB  |  187 lines
  1. program CRC_16;
  2.  
  3. type
  4.    string80   = string[80];
  5.    bit_type   = 0..1;
  6.    crc_type = array [1..16] of bit_type;
  7.  
  8. var
  9.    buffer : string80;
  10.    crc    : crc_type;
  11.  
  12.  
  13. function PowerOf2(n:byte):byte;
  14. var
  15.    temp : byte;
  16. begin
  17.    temp := 1;
  18.    while n > 0 do
  19.       begin
  20.          temp := temp * 2;
  21.          dec(n)
  22.       end;
  23.    PowerOf2 := temp
  24. end;
  25.  
  26.  
  27. function LPad(s:string; pad_char:char; pad_length:byte):string;
  28. var
  29.    len,i : byte;
  30. begin
  31.    len := length(s);
  32.    if len < pad_length then
  33.       for i := pad_length downto len+1 do
  34.          s := pad_char + s;
  35.    lpad := s
  36. end;
  37.  
  38.  
  39. procedure InitCRC(var crc:crc_type; bit:bit_type);
  40. var i : byte;
  41. begin
  42.    for i := 1 to 16 do
  43.       crc[i] := bit;
  44. end;
  45.  
  46.  
  47. function IntToHex(n:integer):string;
  48. var
  49.    temp : string;
  50.    base : byte;
  51. begin
  52.    temp := '';
  53.    while n > 0 do
  54.       begin
  55.          if n div 16 >= 0 then
  56.             begin
  57.                if n mod 16 > 9 then
  58.                   base := 55
  59.                else
  60.                   base := 48;
  61.                temp := chr(base + n mod 16) + temp;
  62.             end;
  63.          n := n div 16
  64.       end;
  65.    IntToHex := temp
  66. end;
  67.  
  68.  
  69. function CharToHex(ch:char):string;
  70. begin
  71.    CharToHex := IntToHex(ord(ch))
  72. end;
  73.  
  74.  
  75. function BinToInt(bit_str:string):byte;
  76. var
  77.    exponent,len,temp,i : byte;
  78. begin
  79.    len := length(bit_str);
  80.    exponent := 0;
  81.    temp := 0;
  82.    for i:=len downto 1 do
  83.       begin
  84.          if bit_str[i] = '1' then
  85.              temp := temp + PowerOf2(exponent);
  86.          inc(exponent)
  87.       end;
  88.    BinToInt := temp
  89. end;
  90.  
  91.  
  92. function IntToBin(n:integer):string;
  93. var
  94.    temp : string;
  95. begin
  96.    temp := '';
  97.    while n > 0 do
  98.       begin
  99.          if n div 2 >= 0 then
  100.             temp := chr(48 + n mod 2) + temp;
  101.          n := n div 2
  102.       end;
  103.    IntToBin := LPad(temp,'0',8)
  104. end;
  105.  
  106.  
  107. function CharToBin(ch:char):string;
  108. begin
  109.    CharToBin := IntToBin(ord(ch))
  110. end;
  111.  
  112.  
  113.  
  114. procedure CalcCRC(var crc:crc_type; buffer:string80);
  115. var
  116.    i,j,len1,len2 : byte;
  117.    bin_str : string[8];
  118.                        
  119.    procedure ShiftLeft(var crc:crc_type; in_bit_char:char);
  120.    var
  121.       temp_crc : crc_type;
  122.       in_bit   : bit_type;
  123.       i        : byte;
  124.    begin {ShiftLeft}
  125.       InitCRC(temp_crc,0);
  126.       in_bit := ord(in_bit_char) - 48;
  127.       for i := 16 downto 1 do
  128.          case i of
  129.             1,14     : temp_crc[i] := crc[1] xor crc[i+1];
  130.             2..13,15 : temp_crc[i] := crc[i+1];
  131.             16       : temp_crc[i] := crc[1] xor in_bit;
  132.          end; {case}
  133.       crc := temp_crc
  134.    end; {ShiftLeft}
  135.                        
  136. begin {CalcCRC}
  137.    len1 := length(buffer);
  138.    for i := 1 to len1 do
  139.       begin
  140.          bin_str := CharToBin(buffer[i]);
  141.          len2 := length(bin_str);
  142.          for j := 1 to len2 do
  143.             ShiftLeft(crc,bin_str[j])
  144.       end;
  145.    for i := 1 to 16 do
  146.       ShiftLeft(crc,'0')
  147. end;
  148.  
  149.  
  150. procedure PrintCRC(crc:crc_type);
  151. var
  152.    hi_byte,lo_byte : string[8];
  153.    i : byte;
  154. begin
  155.    hi_byte := '';
  156.    lo_byte := '';
  157.    for i := 1 to 8 do
  158.       hi_byte := hi_byte + chr(48 + crc[i]);
  159.    for i := 9 to 16 do
  160.       lo_byte := lo_byte + chr(48 + crc[i]);
  161.    writeln('(D) ',BinToInt(hi_byte),':',BinToInt(lo_byte));
  162.    writeln('(B) ',hi_byte,':',lo_byte);
  163.    writeln('(H) ',IntToHex(BinToInt(hi_byte)),':',
  164.                   IntToHex(BinToInt(lo_byte)));
  165. end;
  166.  
  167.  
  168. begin
  169.    writeln;
  170.    writeln('Enter text (blank line quits):');
  171.    writeln;
  172.    write('>');
  173.    readln(buffer);
  174.    writeln;
  175.    while length(buffer) > 0 do
  176.       begin
  177.          InitCRC(crc,0);
  178.          CalcCRC(crc,buffer);
  179.          PrintCRC(crc);
  180.          writeln;
  181.          write('>');
  182.          readln(buffer);
  183.          writeln
  184.       end;
  185.    writeln('Bye!')
  186. end.
  187.